home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
turbovis
/
fsserial.zip
/
SERTEST.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-01-29
|
9KB
|
321 lines
{$DEFINE TVSPY} {Define this if you want the TVSPY program installed}
Program Serial_Test;
Uses App, Objects, Drivers, Views, Menus, Gadgets,
{$IFDEF TVSPY}
EventWin,
{$ENDIF}
Serial, AnsiView, Crt;
CONST MaxScreen = 100;
TYPE
PDummy = ^TDummy;
TDummy = OBJECT(TANSIView)
Count : WORD;
CONSTRUCTOR Init;
PROCEDURE DisplayEvent(VAR Event : TEvent);
PROCEDURE Idle; VIRTUAL;
END;
TSerialApp = OBJECT(TApplication)
Clock : PClockView;
Heap : PHeapView;
Dummy : PDummy;
CONSTRUCTOR Init;
PROCEDURE Idle; VIRTUAL;
PROCEDURE HandleEvent(VAR Event : TEvent); VIRTUAL;
PROCEDURE InitStatusLine; VIRTUAL;
PROCEDURE InitMenuBar; VIRTUAL;
PROCEDURE GetEvent(VAR E : TEvent); VIRTUAL;
END;
PTermWindow = ^TTermWindow;
TTermWindow = OBJECT(TANSIView)
Port : BYTE;
Carrier : BOOLEAN;
TxBuffer : BOOLEAN;
DTRState : BOOLEAN;
CONSTRUCTOR Init(PortNum : BYTE; Bounds : TRect);
PROCEDURE HandleEvent(VAR Event : TEvent); VIRTUAL;
DESTRUCTOR Done; VIRTUAL;
END;
VAR MyApp : TSerialApp;
CONST cmPort1 = 250;
cmPort2 = 252;
cmPort3 = 253;
cmPort4 = 254;
cmOpen = 100;
cmNew = 101;
cmChangeDir = 102;
cmDosShell = 103;
cmCalculator = 104;
cmShowClip = 105;
CONSTRUCTOR TTermWindow.Init;
VAR s : STRING;
E : TEvent;
Max : TPoint;
BEGIN
IF (PortNum < 0) OR (PortNum > 3) THEN
FAIL;
Port := PortNum;
STR(PortNum + 1:0,s);
Max.X := 80;
Max.Y := 25;
TANSIView.Init(Bounds,Max,'Terminal Window (COM ' + s + ')',PortNum + 1);
E.What := evSerial;
E.Command := serInit;
E.InfoByte := Port;
MyApp.HandleEvent(E);
E.What := evSerial;
E.Command := serBaud;
E.InfoLong := 2400 SHL 16;
E.InfoByte := Port;
MyApp.HandleEvent(E);
E.What := evSerial;
E.Command := serEventGenOn;
MyApp.HandleEvent(E);
Carrier := FALSE;
TxBuffer := FALSE;
DTRState := FALSE;
EventMask := EventMask OR evSerial;
CursorOn;
END;
PROCEDURE TTermWindow.HandleEvent;
VAR ch : CHAR;
BEGIN
TANSIView.HandleEvent(Event);
IF (Event.What = evSerial) THEN
IF (Event.Command = serRecvLine) AND (RecvRec(Event.InfoPtr^).Port = Port) THEN
Print(RecvRec(Event.InfoPtr^).St)
ELSE
IF Event.InfoByte = Port THEN
CASE Event.Command OF
serCarrier : Carrier := BOOLEAN(HI(Event.InfoWord));
serTxBuffer : TxBuffer := BOOLEAN(HI(Event.InfoWord));
serRecvChar : PrintChar(CHAR(HI(Event.InfoWord)));
ELSE EXIT;
END;
{Real Bogus Code Here}
IF GetState(sfSelected) AND (Event.What = evKeyDown) THEN
BEGIN
IF (ch = #27) OR ((ch >= ' ') AND (ch <= '~')) THEN
BEGIN
ch := Event.CharCode;
Event.What := evSerial;
Event.Command := serSend;
Event.InfoWord := BYTE(ch) SHL 8;
Event.InfoByte := Port;
PutEvent(Event)
END
ELSE
EXIT
END
ELSE
EXIT;
ClearEvent(Event)
END;
DESTRUCTOR TTermWindow.Done;
VAR E : TEvent;
BEGIN
E.What := evSerial;
E.Command := serDeInit;
E.InfoByte := Port;
MyApp.HandleEvent(E);
TANSIView.Done
END;
CONSTRUCTOR TDummy.Init;
VAR R : TRect;
B : TPoint;
x : BYTE;
y : BYTE;
BEGIN
x := RANDOM(30);
y := RANDOM(10);
R.Assign(x,y,x + 50,y + 10);
B.X := 80;
B.Y := 25;
TANSIView.Init(R,B,'Dummy Window',0);
Count := 0;
Flags := wfMove + wfGrow;
END;
PROCEDURE TDummy.DisplayEvent;
VAR i : INTEGER;
os : STRING;
FUNCTION disp_hex(b : BYTE) : STRING;
CONST hexstr : ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
BEGIN
disp_hex := hexstr[(b AND $F0) SHR 4] + hexstr[b AND $0F] + ' ';
END;
BEGIN
IF Event.What = evSerial THEN
BEGIN
CASE Event.Command OF
serRecvChar : print(disp_hex(HI(Event.InfoWord)));
serRecvLine : BEGIN
os := '';
FOR i := 1 TO LENGTH(RecvRec(Event.InfoPtr^).st) DO BEGIN
IF LENGTH(os) > 240 THEN
BEGIN
print(os);
os := '';
END;
os := os + disp_hex(ORD(RecvRec(Event.InfoPtr^).st[i]));
END;
print(os)
END;
END
END
END;
PROCEDURE TDummy.Idle;
BEGIN
END;
CONSTRUCTOR TSerialApp.Init;
VAR R : TRect;
Max : TPoint;
BEGIN
RANDOMIZE;
TApplication.Init;
RegisterSerial;
RegisterANSIView;
SerialSys := NEW(PSerial,Init); {Install the Serial Port system}
Desktop^.Insert(SerialSys);
GetExtent(R);
R.A.X := R.B.X - 9;
R.B.Y := R.A.Y + 1;
Clock := NEW(PClockView,Init(R));
Insert(Clock);
GetExtent(R);
Dec(R.B.X);
R.A.X := R.B.X - 9;
R.A.Y := R.B.Y - 1;
Heap := NEW(PHeapView,Init(R));
Insert(Heap);
{$IFDEF TVSPY}
Desktop^.GetExtent(R);
R.Assign(R.A.X,R.B.Y-10,R.B.X div 2,R.B.Y);
EventWindow := NEW(PEventWindow,Init(R,'Event Window',wnNoNumber,100));
Desktop^.Insert(EventWindow);
EventWindow^.InsertCommand(cmPort1,'cmPort1');
EventWindow^.InsertCommand(cmPort2,'cmPort2');
EventWindow^.InsertCommand(cmPort3,'cmPort3');
EventWindow^.InsertCommand(cmPort4,'cmPort4');
EventWindow^.InsertCommand(cmOpen,'cmOpen');
EventWindow^.InsertCommand(cmNew,'cmNew');
EventWindow^.InsertCommand(cmChangeDir,'cmChangeDir');
EventWindow^.InsertCommand(cmDosShell,'cmDosShell');
EventWindow^.InsertCommand(cmCalculator,'cmCalculator');
EventWindow^.InsertCommand(cmShowClip,'cmShowClip');
{$ENDIF}
Dummy := NEW(PDummy,Init);
DeskTop^.Insert(Dummy);
END;
PROCEDURE Add_Serial(Port : BYTE);
VAR R : TRect;
BEGIN
R.Assign(10,0,60,12);
Desktop^.Insert(NEW(PTermWindow,Init(Port,R)));
END;
PROCEDURE TSerialApp.HandleEvent;
BEGIN
TApplication.HandleEvent(Event);
CASE Event.What OF
evCommand : CASE Event.Command OF
cmPort1 : Add_Serial(0);
cmPort2 : Add_Serial(1);
cmPort3 : Add_Serial(2);
cmPort4 : Add_Serial(3);
ELSE EXIT
END;
ELSE EXIT
END;
ClearEvent(Event)
END;
PROCEDURE TSerialApp.Idle;
BEGIN
TApplication.Idle;
Clock^.Update;
SerialSys^.Idle;
Heap^.Update;
Dummy^.Idle;
END;
PROCEDURE TSerialApp.GetEvent;
BEGIN
TApplication.GetEvent(E);
{$IFDEF TVSPY}
EventWindow^.DisplayEvent(E);
{$ENDIF}
Dummy^.DisplayEvent(E);
END;
PROCEDURE TSerialApp.InitStatusLine;
VAR R : TRect;
BEGIN
GetExtent(R);
R.A.Y := R.B.Y - 1;
StatusLine := NEW(PStatusLine,Init(R,
NewStatusDef(0,$FFFF,
NewStatusKey('~Alt-X~ Exit',kbAltX,cmQuit,
NIL),
NIL)
))
END;
PROCEDURE TSerialApp.InitMenuBar;
VAR R : TRect;
BEGIN
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := NEW(PMenuBar,Init(R,NewMenu(
NewSubMenu('~F~ile',hcNoContext,NewMenu(
NewItem('~O~pen','F3',kbF3,cmCancel,